perm filename PARTS.F4[RST,LCS] blob
sn#237516 filedate 1976-09-19 generic text, type T, neo UTF8
00100 C THIS AIDS IN EXTRACTING PARTS FROM SCORES. SEE PT1.CMD
00200 COMMON/STF/RSTFAC(-3/4),RSTJ2 /POSI/STFF(-3/4),JJ2,JPQ
00300 1 /IVV/IWDS(200)
00400 COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00500 C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00600 COMMON/XRN/RN(4000) /SF/KL,RT,KP,STFSZ,NAMX
00700 1 /PTR/PWDS(700)/LLL/L,LL,I,IX/XXX/LK,LP,JY
00800 C INCREASE DIMENSION OF PWDS FOR VERY FULL PAGES.
00900 DIMENSION KNM(10),NRD(100),MM(4000),NN(4000),
01000 1 KWDS(1),KPN(1)
01100 COMMON /PX/PN(1800) /Q/Q(8200)
01200 COMMON /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01300 DATA FIB/.7/,RSPC/24./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01400 1 ,RLTRSZ/1.0/,SPCNT/0.7/
01500 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
01600 1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT)
01700 1,(MM,RN),(NN,RN(4001)),(KWDS,PWDS),(KPN,PN)
01800 C RQ(2) IS R4, RQ(3) IS R5 ETC.
01900
01950 IPG=0
02000 JNM=1
02100 MRD=0
02200 JRD=0
02300
02400 TYPE 3
02500 ACCEPT 2,RS,NTYPE
02600 C TYPE ANY NUM AFTER NAME(I.E.5 SPACES) TO PRINT INST. NAMES AS READ.
02700 IF(RS.EQ.' ')RS='OLD'
02800 IF(RS.EQ.'OLD')CALL PT2
02900 CALL IFILE(1,RS)
03000 244 FORMAT(I,A5,30I)
03100 544 READ(1,244,END=344),K,KNM(JNM),(IWDS(K),K=1,30)
03200 JNM=JNM+1
03300 DO 444 K=1,30
03400 J=IWDS(K)
03500 JRD=JRD+1
03600 NRD(JRD)=J
03700 444 IF(J.EQ.0)GO TO 544
03800
03900 344 KNM(JNM)='ZZZZZ'
04000 JNM=1
04100 JRD=0
04200 744 XSIG=FIB
04300 CLEF=-1
04400 XMTR=FIB
04500 XLFT=0
04600 ENDLN=0
04700 KQ=0
04800 YCLEF=2.
04900 YSIG=2.
05000 YMTR=2.
05100 KW=1
05200 KX=1
05300 RSTAFF=0
05400 RM=0
05500 L=1
05600 LK=1
05700 CC IF(LSTNM.NE.0)GO TO 87
05800 CC10 IF(LSTNM.EQ.0)GO TO 83
05900 CC87 IF(NAME.GE.LSTNM)GO TO 83
06000 CC NAME=NAME+2
06100 CC GO TO 84
06200 86 FORMAT(1XA5)
06300 3 FORMAT(' TYPE FILE NAME ',$)
06400 CC300 FORMAT(' TYPE FINAL NAME ',$)
06500 CC83 IF(JRD.EQ.0)GO TO 183
06600
06700 83 NAME=KNM(JNM)
06800 JNM=JNM+1
06900 IF(NAME.EQ.'ZZZZZ')GO TO 20
07000 JREAD=-1
07100 JRD=JRD+1
07200 NXX=NRD(JRD)
07300 NAMZ=NAME
07400 GO TO 284
07500
07600 CC LSTNM=KNM(JNM)-2
07700 C ALL DONE ↑↑
07800 CC GO TO 283
07900 CC183 TYPE 3
08000 CC ACCEPT 2,NAME
08100 CC IF(NAME.EQ.' ')GO TO 83
08200 CC IF(NAME.EQ.'X')GO TO 20
08300 CC TYPE 300
08400 CC ACCEPT 2,LSTNM
08500 CC IF(LSTNM.EQ.' ')LSTNM=NAME
08600 CC IF(LSTNM.EQ.' ')GO TO 83
08700 CC283 NAMZ=NAME
08800
08900 10 IF(LOOKF(NAME))GO TO 284
09000 NAME=NAMZ+256
09100 IF(LOOKF(NAME).GE.0)GO TO 83
09200 NAMZ=NAME
09300 C FOUND NO MORE TO READ
09400 284 JZ=0
09500 SN=200
09600 SNMTR=SN
09700 IF(RM.NE.0)GO TO 277
09800 RM=-1
09900 4 FORMAT(' TYPE INST NAME '$)
10000 TYPE 4
10100 ACCEPT 2,RNAM,K
10200 RNAM2=0
10300 RNAM3=0
10400 RNAM4=0
10500 IF(K.EQ.0)GO TO 277
10600 TYPE 177
10700 ACCEPT 2,RNAM2,K
10800 IF(K.EQ.0)GO TO 277
10900 C TYPE NUM AFTER NAME TO ENTER UP TO 4 NAMES.
11000 TYPE 177
11100 ACCEPT 2,RNAM3
11200 TYPE 177
11300 ACCEPT 2,RNAM4
11400 177 FORMAT(' OTHER INST NAME ',$)
11500
11600 CC IF(INM.EQ.'99')GO TO 20
11700 CC K=SN/100.
11800 CC77 TYPE 86,NAME
11900 CC IF(JRD.EQ.0)GO TO 777
12000 C FOR COMMAND FILE
12100 CC N=NRD(JRD)
12200 CC N=N-1
12300 CC NRD(JRD)=N
12400 CC IF(N.GT.0)GO TO 277
12500 CC IF(NRD(JRD+1))LSTNM=NAME
12600 CC IF(N.EQ.0)GO TO 277
12700 CC JRD=JRD+1
12800 CC IF(N.EQ.-1)GO TO 43
12900 CC GO TO 83
13000 CC777 IF(KW.EQ.1)GO TO 277
13100 CC TYPE 577
13200 CC ACCEPT 2,PG
13300 CC IF(PG.EQ.'N')GO TO 43
13400 CC577 FORMAT(' N=NEW BRACE OR <CR> ',$)
13500 CC277 REWIND 21
13600
13700 277 TYPE 86,NAME
13800 CALL GETFIL(NAME)
13900 CC CALL IFILE(21,NAME)
14000 C LP IS START OF RN ARRAY THIS TIME
14100 CALL FASTIN(RSTFAC,20)
14200 CALL FASTIN(PWDS(KW),JJ2)
14300 CALL FASTIN(RN(KX),JPQ)
14400 CC IF(JREAD)GO TO 477
14500 C SKIP FIRST TIME FOR THIS PAGE
14600 LA=KX-1
14700 P=0
14800 DO 577 K=KW,KW+JJ2-3
14900 J=KWDS(K)+LA
15000 R=RN(J+1)
15100 IF(R.NE.8)GO TO 677
15200 IF(RN(J).LT.6)GO TO 577
15300 C NO NAME ON THIS STAFF - SO JUMP
15400 IF(RN(J+7).NE.0)GO TO 577
15500 C SKIPS INVISIBLE STAVES.
15600 XLFT=RN(J+3)
15700 C LEFT LIMIT OF STAFF
15800 R9=RN(J+9)
15900 IF(NTYPE.NE.0)TYPE 86,R9
16000 IF(R9.EQ.RNAM)GO TO 977
16100 IF(RNAM2.EQ.R9)GO TO 977
16200 IF(RNAM3.EQ.R9)GO TO 977
16300 IF(RNAM4.NE.R9)GO TO 577
16400 977 SN=RN(J+2)+RSTAFF
16500 SNMTR=SN
16600 GO TO 477
16700 677 IF(R.NE.10)GO TO 79
16800 IF(RN(J).LT.4)GO TO 79
16900 IF(RN(J+6).GT.RNUM)GO TO 79
17000 C SKIPS PAGE NUMS. (I.E. BIG SIZE)
17100 IF(RN(J).GE.6)P=-1
17200 C FOUND A NUM. IN BOX ↑↑, REMEMBER IT DID.
17300 GO TO 577
17400 79 IF(R.NE.16)GO TO 577
17500 IF(RN(J+5).GE.100)P=-1
17600 C PICKS UP WORD WITH SZ >100
17700 577 CONTINUE
17800 C DIDN'T FIND USEFUL INFO SO SKIP THIS FILE
17900 IF(JREAD.OR.P)GO TO 477
18000 C ALWAYS USE THE FIRST FILE READ AND FILES WITH REHRSL NUMS.
18100 KWDS(KW)=LA
18200 GO TO 877
18300
18400 CC READ(21),ITEM,I,
18500 CC 1 (PWDS(K),K=KW,ITEM+KW),(RN(K),K=KX,I+KX-2),ISCR,(IV(K),K=1,ISCR),
18600 CC 1 LCNT,(IV(K),K=1,LCNT),RSTFAC,STFF
18700
18800 477 I=JPQ-2
18900 C READS AND WRITES 1 EXTRA WORD
19000 ITEM=JJ2+KW-3
19100 CC ITEM=ITEM+KW-1
19200 JREAD=0
19300 IF(KW.NE.1)CALL LOOP1
19400 RSTAFF=RSTAFF+8
19500
19600 CC IF(KW.EQ.1)GO TO 377
19700 CC DO 477 K=KW,ITEM+1
19800 CC PWDS(K)=PWDS(K)+R
19900 CC LA=PWDS(K)+2
20000 CC477 RN(LA)=RN(LA)+RSTAFF
20100 C FOR COMBINED FILES
20200 377 KW=ITEM+1
20300
20400 CC R=PWDS(KW)-1
20500 KK=JPQ
20600 CC KX=KX+I-1
20700 KX=KX+JPQ
20800
20900 CC NAME=NAME+2
21000 CC IF(NAME.GT.LSTNM)GO TO 44
21100 CC IF(LOOKF(NAME))GO TO 257
21200 CC43 NAME=NAME-2
21300
21400 877 NXX=NXX-1
21500 NAME=NAME+2
21600 IF(NXX.NE.0)GO TO 277
21700 JRD=JRD+1
21800 NXX=NRD(JRD)
21900 IF(NXX.NE.0)GO TO 44
22000 NAME=0
22100 NAMZ=0
22200 44 KX=1
22300 JREAD=-1
22400 RSTAFF=0
22500 KW=1
22600 13 IWDS(1)=1
22700 YN=0
22800 IF(SN.NE.200)GO TO 8
22900 YN=-1
23000 IF(YCLEF.GT.1)YCLEF=-1
23100 IF(YSIG.GT.1)YSIG=-1
23200 IF(YMTR.GT.1)YMTR=-1
23300
23400 8 ZLFT=XLFT+.5
23500 RNUM=PGNUM
23600 C SIZE FACTOR FOR PAGE NUMBER FINDER (MAYBE).
23700
23800 DO 6 K=1,ITEM
23900 R5=-1
24000 J=KWDS(K)
24100 R=RN(J+1)
24200 IF(R.NE.10)GO TO 800
24300 IF(RN(J).LT.4)GO TO 80
24400 IF(RN(J+6).GT.RNUM)GO TO 6
24500 C SKIPS PAGE NUMS. (I.E. BIG SIZE)
24600 IF(RN(J).LT.6)GO TO 80
24700 C FOUND A NUM. IN BOX ↓↓
24800 RN(J+6)=RNMSZ
24900 RN(J+4)=RNMHT
25000 C THE ABOVE SET HEIGHT AND SIZE OF REHEARSAL NUMS.
25100 CC2182 RN(J+2)=SN
25200 CC IF(YN.EQ.'Y')RPOS=RN(J+3)-3.
25300 GO TO 810
25400 800 IF(R.NE.4)GO TO 80
25500 CCC IF(NBAR)GO TO 80
25600 IF(RN(J).NE.2)GO TO 182
25700 C FOUND A BAR LINE
25800 IF(RN(J+3).LT.ZLFT)GO TO 6
25900 C DROPS BAR LINE AT LEFT OF STAFF.
26000 CC KZ=RN(J+4)/100.
26100 CC RN(J+4)=1.+KZ*100.
26200 C KZ IS FOR THICK BARS.
26300 CC RR=RN(J+3)
26400 CC DO 82 KY=K+1,ITEM
26500 CC KZ=PWDS(KY)
26600 CC IF(RN(KZ+1).NE.4)GO TO 82
26700 CC IF(RN(KZ).NE.2)GO TO 82
26800 C AVOIDS DUPLICATE BARS.
26900 CC IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82CC
27000 CC RN(KZ+2)=99
27100 CC RN(KZ+1)=0
27200 CC82 CONTINUE
27300 CALL DBAR(K,ITEM,J)
27400 IF(YN.EQ.0)GO TO 810
27500 CC CALL ADDRST(RR,XWDS,PN)
27600 CALL ADRST(IWDS)
27700 GO TO 6
27800 182 RN(J+1)=44
27900 C CHANGES CODE NUM
28000 IF(RN(J).LT.5)GO TO 80
28100 IF(RN(J+7).GE.3)GO TO 6
28200 C SKIP HEAVY BRACKETS.
28300 80 IF(R.NE.16)GO TO 180
28400 IF(RN(J+5).GE.100)RN(J+2)=SN
28500 C CATCHES WANTED TEXT ON OTHER LINES. (P5>100)
28600 IF(RN(J+5).GT.RLTRSZ)RN(J+5)=RLTRSZ
28700 C LIMITS SIZE OF LETTERS. ADJUST RLTRSZ TO SUIT. (SET AT 1.0 NOW)
28800 180 RSN=RN(J+2)
28900 C THE STAFF NUM.
29000 IF(R.NE.3)GO TO 3801
29100 IF(YCLEF)GO TO 4801
29200 IF(RSN.NE.SN)GO TO 6
29300 4801 RR=AMOD(RN(J+5),100.0)
29400 C ↑↑↑↑↑ BECAUSE SOME CLEFS ARE MINI-CLEFS
29500 IF(RN(J).LT.3)RR=0
29600 IF(RR.EQ.CLEF)GO TO 6
29700 C SKIP DUPLICATE CLEFS.
29800 IF(RR.GT.3.AND.RR.LT.100)GO TO 4800
29900 C CATCHES CLEFS (≤3) OR MINI-CLEFS (>3)
30000 IF(YCLEF.GE.0)GO TO 17
30100 TYPE 16,RR
30200 16 FORMAT(' CLEF=',F2.0,' --CHANGE TO--',$)
30300 ACCEPT 5,RR
30400 R5=RR
30500 17 CLEF=RR
30600 C** IF(YCLEF.EQ.1)GO TO 4802
30700 C** IF(YCLEF)YCLEF=1.
30800 YCLEF=0
30900 GO TO 1800
31000 4800 IF(RSN.NE.SN)GO TO 6
31100 RN(J+1)=33
31200 GO TO 1800
31300 4802 YCLEF=0
31400 C CATCHES CLEF AFTER FIRST RESTS.
31500 GO TO 6
31600 3801 IF(R.NE.17)GO TO 3800
31700 IF(YSIG)GO TO 3802
31800 IF(RSN.NE.SN)GO TO 6
31900 3802 RR=RN(J+5)
32000 IF(RR.EQ.XSIG)GO TO 6
32100 YSIG=0
32200 XSIG=RR
32300 C SKIPS DUPL. KEY SIGS.
32400 GO TO 1800
32500 3800 IF(R.EQ.8)GO TO 6
32600 C OMIT ALL STAVES FOR NOW
32700 IF(R.NE.18.)GO TO 81
32800 IF(YMTR)GO TO 1801
32900 IF(SNMTR.EQ.200.)SNMTR=RSN
33000 C SO IT WON'T REPEAT METERS.
33100 C CHECK ALL METERS IF LINE HAS NOT THIS INST.
33200 IF(RSN.NE.SNMTR)GO TO 6
33300 1801 RA=RN(J+5)*100.+RN(J+6)
33400 C THE TIME SIG.
33500 IF(XMTR.EQ.RA)GO TO 6
33600 XMTR=RA
33700 YMTR=0
33800 GO TO 1800
33900 81 IF(RSN.NE.SN)GO TO 6
34000 1800 IF(RN(J+3).LT.XLFT)GO TO 6
34100 C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
34200 IF(R.NE.5)GO TO 810
34300 C NEXT CHECKS FOR SLUR OVER END OF LINE
34400 IF(RN(J+6).GE.199.)RN(J+6)=200.
34500 C ****** 200.0 ABOVE IS SUBJECT TO CHANGE!
34600 810 CALL PNRN(J,IWDS,K)
34700 CC810 JA=PWDS(K+1)
34800 CC RN(J+2)=RS
34900 CC DO 7 KY=J,JA-1
35000 CC PN(LK)=RN(KY)
35100 CC7 LK=LK+1
35200 CC IF(R5)GO TO 6666
35300 CC IF(PN(J).EQ.2)LK=LK+1
35400 CC PN(J)=3
35500 CC PN(J+5)=R5
35600 CC6666 L=L+1
35700 CC XWDS(L)=LK
35800 6 CONTINUE
35900
36000 C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
36100 CC I=1
36200 CC DO 243 K=1,L-1
36300 CC LB=XWDS(K)+1
36400 CC IF(PN(LB).NE.16)GO TO 243
36500 CC IF(PN(LB-1).LT.8)GO TO 243
36600 CC JL=XWDS(K-1)
36700 CC244 PN(LB+2)=PN(JL+3)
36800 C PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
36900 C FOR SPACING PROBLEMS BELOW.
37000 CC243 CONTINUE
37100 CC M=2
37200 CC J=1
37300 CC24 RA=100000.
37400 C POSITION
37500 CC DO 21 K=1,L-1
37600 CC JL=XWDS(K)+3
37700 CC R=PN(JL)
37800 CC IF(R.EQ.100000)GO TO 21
37900 CC241 IF(ABS(R-RA).GT..1)GO TO 240
38000 CC R=RA
38100 CC PN(JL)=R
38200 C PUT IN HERE MULTI-VOICE TRAP
38300 CC GO TO 21
38400 CC240 IF(R.GT.RA)GO TO 21
38500 C LINES THEM UP
38600 CC I=K
38700 CC RA=R
38800 CC21 CONTINUE
38900 CC IF(RA.EQ.100000)GO TO 23
39000 C JUMP IF ALL SORTED
39100 CC242 JL=XWDS(I)
39200 CC LA=JL
39300 CC N=PN(JL)+3
39400 C NEXT POINTER
39500 CC PWDS(M)=PWDS(M-1)+N
39600 CC M=M+1
39700 CC DO 22 K=J,J+N-1
39800 CC RN(K)=PN(JL)
39900 CC22 JL=JL+1
40000 CC PN(LA+3)=100000
40100 C PUT IT ASIDE
40200 CC J=N+J
40300 CC GO TO 24
40400 CALL SORT(IWDS)
40500
40600 23 LL=0
40700 C TO 'MOVE' INSTEAD OF 'JUSTIFY'
40800 IF(ENDLN.EQ.0)GO TO 2334
40900 R4=0
41000 R5=1000
41100 R7=0
41200 RS=0
41300 R8=ENDLN
41400 R9=0
41500 GO TO 33
41600 2334 R4=0
41700 R5=10000
41800 CC R8=-XLFT
41900 R8=1.-RN(4)
42000 R9=0
42100 C INSERT?? →→ IF(R8.GT.0)R9=200.
42200 R7=0
42300 RS=0
42400 33 CALL PTMOVE(RN,PWDS)
42500 CC DO 32 K=1,IFIX(PWDS(L))-1
42600 CC KQ=KQ+1
42700 CC32 Q(KQ)=RN(K)
42800 CALL SHFT0(KQ)
42900 CC L=1
43000 CC LK=1
43100 ENDLN=ENDLN+200-XLFT
43200 TYPE 3001,KQ
43300 GO TO 10
43400
43500 27 FORMAT(' RESPACING')
43600 CC20 K=1
43700 20 TYPE 27
43800 CC KK=1
43900 CC220 JJ=Q(K)+3
44000 CC PN(KK)=K
44100 C NEW POINTER
44200 CC K=K+JJ
44300 CC KK=KK+1
44400 CC IF(K.LT.KQ)GO TO 220
44500 CC PN(KK)=K
44600 CALL SHFT1(KQ)
44700 CC L=KK
44800 KK=L
44900 TYPE 3001,L
45000 C DELETES EXTRA BAR LINES, ETC.
45100 CALL RESTS
45200 C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
45300 CC K=1
45400 CC L=1
45500 CC LL=0
45600 CC LK=1
45700 CC221 IF(Q(IFIX(PN(K))+1))GO TO 321
45800 CC DO 421 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
45900 CC LL=LL+1
46000 CC421 Q(LL)=Q(KL)
46100 CC LK=LK+1
46200 CC PN(LK)=LL+1
46300 CC321 K=K+1
46400 CC IF(K.LT.KK)GO TO 221
46500 CC L=LK-1
46600 CALL SHIFT
46700 C L=NUMBER OF ITEMS FOR RHY RECONS.
46800 N=0
46900 S=0
47000 DO 601 K=1,L
47100 J=KPN(K)
47200 N=N+1
47300 MM(N)=J+3
47400 C POS PTR.
47500 R=Q(J+1)
47600 IF(R.GT.4)GO TO 602
47700 IF(R.NE.1)GO TO 2601
47800 IF(Q(J).LT.7)GO TO 2601
47900 IF(Q(J+9))GO TO 602
48000 C JUMP IF R9=-1, AN IGNORED NOTE (NO LEDGER LINES)
48100 2601 IF(R.NE.4)GO TO 3601
48200 LA=K+1
48300 4601 M=KPN(LA)
48400 P=Q(M+1)
48500 IF(P.LT.4)GO TO 3601
48600 IF(P.EQ.4)GO TO 601
48700 C GO ON IF NEXT AFTER BAR IS NOTE, REST, CLEF, KSIG, METER
48800 IF(P.EQ.17)GO TO 3601
48900 IF(P.EQ.18)GO TO 3601
49000 IF(LA.GE.L)GO TO 601
49100 LA=LA+1
49200 GO TO 4601
49300 3601 P=Q(J+3)
49400 IF(ABS(P-S).LE.SPCNT)GO TO 602
49500 C SEE DATA -- SPCNT=SPACE BETWEEN NOTES. <2.5 IS CONSIDERED 0.
49600 S=P
49700 1601 NN(N)=R
49800 C -1= IMPORTANT ITEM FOR SPACING
49900 GO TO 601
50000 602 IF(R.EQ.17)GO TO 1601
50100 IF(R.EQ.18)GO TO 1601
50200 IF(R.NE.9)GO TO 718
50300 IF(Q(J+5).EQ.8)GO TO 1601
50400 C FOR BAR REPEAT SIGN.
50500 718 NN(N)=0
50600 IF(R.GT.7.AND.R.LT.40)GO TO 601
50700 IF(R.LT.5)GO TO 601
50800 C FOR DBL STPS
50900 C NEXT POS2 AND 3 OF CERTAIN ITEMS
51000 N=N+1
51100 MM(N)=J+6
51200 NN(N)=0
51300 IF(R.NE.6)GO TO 601
51400 C NEXT FOR BEAMS
51500 RZ=Q(J)
51600 IF(RZ.LT.8)GO TO 608
51700 IF(Q(J+10).LT.30)GO TO 608
51800 N=N+1
51900 MM(N)=J+8
52000 NN(N)=0
52100 608 IF(RZ.LT.7)GO TO 601
52200 IF(Q(J+7))GO TO 688
52300 IF(Q(J+8))601,689,688
52400 689 IF(RZ.LT.8)GO TO 601
52500 IF(Q(J+10).EQ.0)GO TO 601
52600 C FOUND A POS. IN P9
52700 688 IF(Q(J+9).LE.0)GO TO 601
52800 N=N+1
52900 MM(N)=J+9
53000 NN(N)=0
53100 601 CONTINUE
53200
53300 C NEXT SORTS THE POINTS
53400 6000 J=1
53500 610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
53600 CALL EXCHG(MM(J),NN(J))
53700 C ABOVE EXCHGS --(J) AND --(J+1)
53800 IF(J.EQ.1)GO TO 710
53900 J=J-1
54000 GO TO 610
54100 710 J=J+1
54200 IF(J.LT.N)GO TO 610
54300 C NOW ALL SORTED
54400 S2=Q(MM(1))
54500 P1=S2
54600 C THE ABOVE 2 CAN GO BELOW 612
54700 J=1
54800
54900 612 IF(NN(J).EQ.0)GO TO 613
55000 7102 M=J+1
55100 S1=S2
55200 616 IF(NN(M).NE.0)GO TO 614
55300 IF(M.EQ.N)GO TO 614
55400 M=M+1
55500 GO TO 616
55600 C ASSUMES PROPER END OF LIST
55700 614 K=MM(J)
55800 R=Q(K-2)
55900 C THE CODE #
56000 IF(R.NE.1)GO TO 615
56100 P=Q(K+6)
56200
56300 IF(Q(K-3).GE.7)GO TO 629
56400 2629 TYPE 1629,(Q(LA),LA=K+1,K+6)
56500 P=1.
56600 1629 FORMAT(' NO RHYTHMIC VALUE ',6F8.2)
56700 C WAS THERE A RHYTH VALUE
56800 629 IF(Q(K+5).EQ.1000)GO TO 630
56900 IF(Q(K-3).GE.8.AND.Q(K+7).EQ.1)GO TO 630
57000 C GRACE NOTES R8=1000 OR R10=1
57100 IF(P.GE..25)GO TO 617
57200 DO 1600 K=J+1,N-1
57300 LA=NN(K)
57400 IF(LA.EQ.0)GO TO 1600
57500 IF(LA.GT.4)GO TO 1600
57600 IF(LA.GT.1)GO TO 617
57700 C NEXT IS A NOTE NOW
57800 IF(AMOD(Q(MM+2),10.0).NE.0)P=.25
57900 C ADD SPACE IF NEXT NOTE HAS ACCI AND THIS IS .LT.16TH.
58000 GO TO 617
58100 1600 CONTINUE
58200 GO TO 617
58300 615 IF(R.NE.2)GO TO 618
58400 P=Q(K+4)
58500 IF(P.LT..2)P=.2
58600 C 32ND, 64TH RESTS GET BIGGER!
58700 IF(Q(K-3).GE.5)GO TO 617
58800 C NO VALUE WAS FOUND
58900 GO TO 2629
59000 618 IF(R.EQ.4)P=2.6
59100 IF(R.EQ.3)P=5
59200 IF(R.GE.17)P=3.
59300 IF(R.NE.9)GO TO 628
59400 C FOR BAR REPEAT SIGN. =HALF NOTE SPACE
59500 P=2.
59600 GO TO 617
59700 630 P=.05
59800 C FOR GRACE NOTES
59900 617 IF(P.EQ.0)P=1
60000 IF(P.LT..125)P=.125
60100 IF(P.GT.8)P=8
60200 P=(P+(.125-P)*.7)*RSPC
60300 IF(P.GT.18)P=P-P/7
60400 C MAKE THIS BETTER!!!!
60500 628 K=MM(M)
60600 S2=Q(K)
60700 P2=P1+P
60800 Q(K)=P2
60900 IF(M-J.EQ.1)GO TO 7103
61000 C NEXT ADJUSTS STUFF IN BETWEEN
61100 R=P/(S2-S1)
61200 DO 620 K=J+1,M-1
61300 LA=MM(K)
61400 620 Q(LA)=P1+R*(Q(LA)-S1)
61500 7103 P1=P2
61600 J=M
61700 IF(J.LT.N)GO TO 7102
61800 613 J=J+1
61900 IF(J.LT.N)GO TO 612
62000 C ALL DONE!
62100 C*** IF(XLFT.EQ.0)GO TO 600
62200 C NEXT MOVES LEFT SIDE OF STAFF TO ZERO
62300 CC R5=10000.
62400 CC R7=RS
62500 CC R8=-XLFT
62600 CC R4=-101
62700 CC R9=0
62800 CC CALL PTMOVE(Q,PN)
62900 CC J=1
63000 CC CALL OFILE(1,'PX')
63100 CC LL=PN(L+1)
63200 CC2929 WRITE(1),L,LL,
63300 CC 1(PN(K),K=1,L+1),(Q(K),K=1,LL-1),NAMX,STFSZ,J,J,RSTFAC,STFF,IV,STFF
63400 CALL PUTFIL('PARTS')
63500 2929 JJ2=L+2
63600 JPQ=KPN(L+1)+1
63700 CALL FASTOU(RSTFAC,128)
63800 CALL FASTOU(PN,JJ2)
63900 CALL FASTOU(Q,JPQ)
64000 CALL FINFIL
64100 CALL PT2(PN,Q,PWDS,RN)
64200 2 FORMAT(A5,30I)
64300 3001 FORMAT(2I6)
64400 5 FORMAT(5F)
64500 END